Práctica 2: Limpieza y Análisis de Datos - Síndrome de Ovario Poliquístico
Helene Jordan
Enero 2020
1 Descripción del Dataset
El dataset escogido para esta práctica recoge información médica de 541 pacientes. Esta información se ha recogido en diferentes hospitales de Kerala, India. Todos los pacientes son mujeres y la clasificación principal es la determinación de la presencia del Síndrome de Ovario Poliquístico (PCOS en inglés).
Este dataset contiene las siguientes 43 variables: - Sl. No: index number - Patient File No.: patient’s file’s number - PCOS (Y/N): presence or absence of PCOS - Age (yrs): age in years - Weight (Kg): weight in kg - Height(Cm): height in cm - BMI: Body Mass Indice - Blood Group: blood group - Pulse rate(bpm): pulse rate in bpm - RR (breaths/min): Respiratory rate - Hb(g/dl): hemoglobine - Cycle(R/I): menstrual cycle - Cycle length(days): length of menstrual cycle in days - Marraige Status (Yrs): number of marriage years - Pregnant(Y/N): presence or absence of pregnancy - No. of aborptions: number of aborptions - FSH(mIU/mL): level of hormone FSH - LH(mIU/mL): level of hormone LH (luteinizing hormone) - FSH/LH: follicle stimulating hormone - Hip(inch): size of hip - Waist(inch): size of waist - Waist:Hip Ratio: ratio between hip and waist - TSH (mIU/L): level of TSH (thyroid stimulating hormone) - AMH(ng/mL): level of Anti-Müllerian hormone (AMH) - PRL(ng/mL): level or prolactine - Vit D3 (ng/mL): level of vitamin D3 - PRG(ng/mL): level of progesterone - RBS(mg/dl): random blood sugar - Weight gain(Y/N): presence or absence of weight gain - hair growth(Y/N): presence or absence of hair growth - Skin darkening (Y/N): presence or absence of skin darkening - Hair loss(Y/N): presence or absence of hair loss - Pimples(Y/N): presence or absence of pimples - Fast food (Y/N): if the patient has been eating fast food - Reg.Exercise(Y/N): presence or absence of regular exercises - BP _Systolic (mmHg): systolic blood pressure - BP _Diastolic (mmHg): diastolic blood pressure - Follicle No. (L): number of follicles on the left ovary - Follicle No. (R): number of follicles on the right ovary - Avg. F size (L) (mm): average size in mm of the follicles on the left ovary - Avg. F size (R) (mm): average size in mm of the follicles on the right ovary - Endometrium (mm): size of endometrium in mm
1.1 PCOS
El PCOS es un desorden dentro del aparato reproductivo femenino que implica ciclos menstruales infrecuentes, irregulares y prolongados. Muchas veces viene acompañado de exceso de hormonas masculinas. Los ovarios con este síndrome desarrollan pequeñas acumulaciones de líquidos (llamados folículos) y no consiguen liberar regularmente los óvulos.
No existe prueba médica definitiva para la detección del POCS a día de hoy, sin embargo, se suele hacer una exploración física por radiografía para identificar los folículos dentro del ovario así como orientarse mediante las respuestas a una serie de preguntas sobre el ciclo menstrual de la paciente. El tratamiento de este síndrome tampoco elimina los síntomas, sino que, en ocasiones los hace dismunuir. Se suele recomendar un cambio en el estilo de vida y la toma de píldoras anticonceptivas para poder regular los ciclos y hacer desaparecer los síntomas asociados al síndrome (dolor abdominal, acné, desregulación hormonal entre muchos otros que varían de paciente a paciente).
1.2 Objetivo de la práctica
Este síndrome es más común de lo que podría parecer, ya que afecta a 1 de entre 10 mujeres; por lo que sería de gran interés, descubrir tanto las causas como los síntomas que pueden determinar un diagnóstico eficaz para aplicar un tratamiento lo más adecuado posible.
El obejtivo de esta práctica será entonces determinar las características sociodemográficas, pero sobre, todo médicas que determinen la existencia de PCOS; por lo tanto, determinar qué factores ayudan al correcto diagnóstico de este síndrome.
Este objetivo a cumplir es de gran importancia para el sector médico, ya que cuanta más precisión en el diagnóstico de un paciente, mejor y más específico podrá ser el tratamiento además de que contribuirá a la investigación dentro de las posibles causas de la aparición de este síndrome.
2 Limpieza de datos
2.1 Importación del dataset
El primer paso será importar los datos desde el archivo csv descargado del repositorio de datos Kaggle.
df <- read.csv(file='csv/initial_data.csv', sep= ',')
head(df)## Sl..No Patient.File.No. PCOS..Y.N. Age..yrs. Weight..Kg. Height.Cm.
## 1 1 10001 0 28 44.6 152.0
## 2 2 10002 0 36 65.0 161.5
## 3 3 10003 1 33 68.8 165.0
## 4 4 10004 0 37 65.0 148.0
## 5 5 10005 0 25 52.0 161.0
## 6 6 10006 0 36 74.1 165.0
## BMI Blood.Group Pulse.rate.bpm. RR..breaths.min. Hb.g.dl.
## 1 19.30000 15 78 22 10.48
## 2 24.92116 15 74 20 11.70
## 3 25.27089 11 72 18 11.80
## 4 29.67495 13 72 20 12.00
## 5 20.06095 11 72 18 10.00
## 6 27.21763 15 78 28 11.20
## Cycle.R.I. Cycle.length.days. Marraige.Status..Yrs. Pregnant.Y.N.
## 1 2 5 7 0
## 2 2 5 11 1
## 3 2 5 10 1
## 4 2 5 4 0
## 5 2 5 1 1
## 6 2 5 8 1
## No..of.aborptions FSH.mIU.mL. LH.mIU.mL. FSH.LH Hip.inch. Waist.inch.
## 1 0 7.95 3.68 2.160326 36 30
## 2 0 6.73 1.09 6.174312 38 32
## 3 0 5.54 0.88 6.295455 40 36
## 4 0 8.06 2.36 3.415254 42 36
## 5 0 3.98 0.90 4.422222 37 30
## 6 0 3.24 1.07 3.028037 44 38
## Waist.Hip.Ratio TSH..mIU.L. AMH.ng.mL. PRL.ng.mL. Vit.D3..ng.mL.
## 1 0.8333333 0.68 2.07 45.16 17.1
## 2 0.8421053 3.16 1.53 20.09 61.3
## 3 0.9000000 2.54 6.63 10.52 49.7
## 4 0.8571429 16.41 1.22 36.90 33.4
## 5 0.8108108 3.57 2.26 30.09 43.8
## 6 0.8636364 1.60 6.74 16.18 52.4
## PRG.ng.mL. RBS.mg.dl. Weight.gain.Y.N. hair.growth.Y.N.
## 1 0.57 92 0 0
## 2 0.97 92 0 0
## 3 0.36 84 0 0
## 4 0.36 76 0 0
## 5 0.38 84 0 0
## 6 0.30 76 1 0
## Skin.darkening..Y.N. Hair.loss.Y.N. Pimples.Y.N. Fast.food..Y.N.
## 1 0 0 0 1
## 2 0 0 0 0
## 3 0 1 1 1
## 4 0 0 0 0
## 5 0 1 0 0
## 6 0 1 0 0
## Reg.Exercise.Y.N. BP._Systolic..mmHg. BP._Diastolic..mmHg.
## 1 0 110 80
## 2 0 120 70
## 3 0 120 80
## 4 0 120 70
## 5 0 120 80
## 6 0 110 70
## Follicle.No...L. Follicle.No...R. Avg..F.size..L...mm.
## 1 3 3 18
## 2 3 5 15
## 3 13 15 18
## 4 2 2 15
## 5 3 4 16
## 6 9 6 16
## Avg..F.size..R...mm. Endometrium..mm. X
## 1 18 8.5
## 2 14 3.7
## 3 20 10.0
## 4 14 7.5
## 5 14 7.0
## 6 20 8.02.2 Limpieza de valores nulos o perdidos
En primer lugar, veremos si existen datos perdidos dentro de cada variable.
colSums(is.na(df)|df == '')## Sl..No Patient.File.No. PCOS..Y.N.
## 0 0 0
## Age..yrs. Weight..Kg. Height.Cm.
## 0 0 0
## BMI Blood.Group Pulse.rate.bpm.
## 0 0 0
## RR..breaths.min. Hb.g.dl. Cycle.R.I.
## 0 0 0
## Cycle.length.days. Marraige.Status..Yrs. Pregnant.Y.N.
## 0 1 0
## No..of.aborptions FSH.mIU.mL. LH.mIU.mL.
## 0 0 0
## FSH.LH Hip.inch. Waist.inch.
## 0 0 0
## Waist.Hip.Ratio TSH..mIU.L. AMH.ng.mL.
## 0 0 0
## PRL.ng.mL. Vit.D3..ng.mL. PRG.ng.mL.
## 0 0 0
## RBS.mg.dl. Weight.gain.Y.N. hair.growth.Y.N.
## 0 0 0
## Skin.darkening..Y.N. Hair.loss.Y.N. Pimples.Y.N.
## 0 0 0
## Fast.food..Y.N. Reg.Exercise.Y.N. BP._Systolic..mmHg.
## 1 0 0
## BP._Diastolic..mmHg. Follicle.No...L. Follicle.No...R.
## 0 0 0
## Avg..F.size..L...mm. Avg..F.size..R...mm. Endometrium..mm.
## 0 0 0
## X
## 539Vemos efectivamente que existen datos perdidos para las variables de años de matrimonio y para la consumición de fast food. En cada caso existe un valor perdido.
En el caso de los años de matrimonio seguiremos la estrategia de reemplazar el valor perdido por la mediana de la muestra; de esta manera, como no sabemos cuántos outliers tiene el dataset para esta variable, evitaremos que la media sea sesgada por esos posibles valores extremos. La mediana nos proporcionará un valor más ajustado a la tendencia central sin verse afectada por esos extremos.
En el caso del fast food, como se trata de una variable dicotómica, no tendría sentido reemplazar el valor por la media ya que la variable no acepta valores con decimales. Es por ello que también seguiremos la estrategia de escoger la mediana como indicador de tendencia central y reemplazaremos el valor perdido por este indicador.
Por otra parte, en la variable final (X) existen 539 valores perdidos de 541. Vemos por inspección visual que la variable está vacía, por lo que procederemos a eliminarla.
# Sustitución de los valores perdidos por la mediana de la muestra.
df$Marraige.Status..Yrs.[is.na(df$Marraige.Status..Yrs.)] <- median(df$Marraige.Status..Yrs., na.rm=TRUE)
df$Fast.food..Y.N.[is.na(df$Fast.food..Y.N.)] <- median(df$Fast.food..Y.N., na.rm=TRUE)# Recreamos el dataframe eliminando la última columna que corresponde a una columna con datos vacíos.
df <- df[,c(1:42)]Veamos ahora si todos los datos contienen valores que encajan en cada una de las variables.
str(df)## 'data.frame': 541 obs. of 42 variables:
## $ Sl..No : int 1 2 3 4 5 6 7 8 9 10 ...
## $ Patient.File.No. : int 10001 10002 10003 10004 10005 10006 10007 10008 10009 10010 ...
## $ PCOS..Y.N. : int 0 0 1 0 0 0 0 0 0 0 ...
## $ Age..yrs. : int 28 36 33 37 25 36 34 33 32 36 ...
## $ Weight..Kg. : num 44.6 65 68.8 65 52 74.1 64 58.5 40 52 ...
## $ Height.Cm. : num 152 162 165 148 161 ...
## $ BMI : num 19.3 24.9 25.3 29.7 20.1 ...
## $ Blood.Group : int 15 15 11 13 11 15 11 13 11 15 ...
## $ Pulse.rate.bpm. : int 78 74 72 72 72 78 72 72 72 80 ...
## $ RR..breaths.min. : int 22 20 18 20 18 28 18 20 18 20 ...
## $ Hb.g.dl. : num 10.5 11.7 11.8 12 10 ...
## $ Cycle.R.I. : int 2 2 2 2 2 2 2 2 2 4 ...
## $ Cycle.length.days. : int 5 5 5 5 5 5 5 5 5 2 ...
## $ Marraige.Status..Yrs.: num 7 11 10 4 1 8 2 13 8 4 ...
## $ Pregnant.Y.N. : int 0 1 1 0 1 1 0 1 0 0 ...
## $ No..of.aborptions : int 0 0 0 0 0 0 0 2 1 0 ...
## $ FSH.mIU.mL. : num 7.95 6.73 5.54 8.06 3.98 3.24 2.85 4.86 3.76 2.8 ...
## $ LH.mIU.mL. : num 3.68 1.09 0.88 2.36 0.9 1.07 0.31 3.07 3.02 1.51 ...
## $ FSH.LH : num 2.16 6.17 6.3 3.42 4.42 ...
## $ Hip.inch. : int 36 38 40 42 37 44 39 44 39 40 ...
## $ Waist.inch. : int 30 32 36 36 30 38 33 38 35 38 ...
## $ Waist.Hip.Ratio : num 0.833 0.842 0.9 0.857 0.811 ...
## $ TSH..mIU.L. : num 0.68 3.16 2.54 16.41 3.57 ...
## $ AMH.ng.mL. : Factor w/ 301 levels "0.1","0.16","0.19",..: 125 50 267 42 134 269 173 51 33 55 ...
## $ PRL.ng.mL. : num 45.2 20.1 10.5 36.9 30.1 ...
## $ Vit.D3..ng.mL. : num 17.1 61.3 49.7 33.4 43.8 52.4 42.7 38 21.8 27.7 ...
## $ PRG.ng.mL. : num 0.57 0.97 0.36 0.36 0.38 0.3 0.46 0.26 0.3 0.25 ...
## $ RBS.mg.dl. : num 92 92 84 76 84 76 93 91 116 125 ...
## $ Weight.gain.Y.N. : int 0 0 0 0 0 1 0 1 0 0 ...
## $ hair.growth.Y.N. : int 0 0 0 0 0 0 0 0 0 0 ...
## $ Skin.darkening..Y.N. : int 0 0 0 0 0 0 0 0 0 0 ...
## $ Hair.loss.Y.N. : int 0 0 1 0 1 1 0 0 0 0 ...
## $ Pimples.Y.N. : int 0 0 1 0 0 0 0 0 0 0 ...
## $ Fast.food..Y.N. : num 1 0 1 0 0 0 0 0 0 0 ...
## $ Reg.Exercise.Y.N. : int 0 0 0 0 0 0 0 0 0 0 ...
## $ BP._Systolic..mmHg. : int 110 120 120 120 120 110 120 120 120 110 ...
## $ BP._Diastolic..mmHg. : int 80 70 80 70 80 70 80 80 80 80 ...
## $ Follicle.No...L. : int 3 3 13 2 3 9 6 7 5 1 ...
## $ Follicle.No...R. : int 3 5 15 2 4 6 6 6 7 1 ...
## $ Avg..F.size..L...mm. : num 18 15 18 15 16 16 15 15 17 14 ...
## $ Avg..F.size..R...mm. : num 18 14 20 14 14 20 16 18 17 17 ...
## $ Endometrium..mm. : num 8.5 3.7 10 7.5 7 8 6.8 7.1 4.2 2.5 ...Vemos que la variable AMH.ng.mL. está definida como una variable categórica; sin embargo, por lógica, esta variable debería ser numérica puesto que está describiendo el nivel de una hormona en sangre. Además vemos que los primeros valores que se nos muestran son, efectivamente, numéricos.
Observemos esta variable para saber si hay algún dato en string, y cambiar el formato a numérico.
df$AMH.ng.mL. <- as.numeric(as.character(df$AMH.ng.mL.))## Warning: NAs introducidos por coerciónPuesto que hemos recibido el warning de que se han introducido NAs por coerción, intuimos que hay una valor string introducido para un valor perdido. En este caso, también reemplazaremos este valor nulo por la mediana de la variable.
df$AMH.ng.mL.[is.na(df$AMH.ng.mL.)] <- median(df$AMH.ng.mL., na.rm=TRUE)2.3 Análisis descriptivo para detectar valores extremos
Los valores extremos, bien que comunes en la vida real, suelen distorsionar las muestras estadísticas si existen en demasía. Por lo que es muy importante detercarlos y tomar una decisión sobre su presencia o eliminación de la muestra.
En primer lugar, mostraremos los histogramas de las variables cuantitativas para observar qué variable sparecen tener más o menos outliers.
2.3.1 Histogramas para las variables cuantitativas
df %>%
gather(Attributes, value, c(4:7, 9:14, 16:17)) %>%
ggplot(aes(x=value, fill=Attributes)) +
geom_histogram(colour="black", show.legend=FALSE, bins = 10) +
facet_wrap(~Attributes, scales="free_x") +
labs(x="Values", y="Frequency",
title="Histograms of dimensions",
subtitle="Histograms") +
theme_bw()
df %>%
gather(Attributes, value, c(18:28)) %>%
ggplot(aes(x=value, fill=Attributes)) +
geom_histogram(colour="black", show.legend=FALSE, bins = 10) +
facet_wrap(~Attributes, scales="free_x") +
labs(x="Values", y="Frequency",
title="Histograms of dimensions",
subtitle="Histograms") +
theme_bw()
df %>%
gather(Attributes, value, c(36:42)) %>%
ggplot(aes(x=value, fill=Attributes)) +
geom_histogram(colour="black", show.legend=FALSE, bins = 10) +
facet_wrap(~Attributes, scales="free_x") +
labs(x="Values", y="Frequency",
title="Histograms of dimensions",
subtitle="Histograms") +
theme_bw()
Veamos ahora, de las variables cuantitativas, las que, por inspección visual nos han parecido tener más outliers y veamos qué decisión debemos tomar al respecto con cada una de las variables.
par(mfrow = c(2,3))
list = list(13, 25, 40, 41, 42)
for (i in list){
boxplot(df[,i], main = colnames(df)[i], width = 100)
}
En primer lugar, para el número de días del ciclo todos los valores son posibles puesto que los ciclos menstruales varían mucho entre mujeres. En segundo lugar, el nivel de prolactina, vemos que tiene muchos outliers. En este caso, la prolactina es una hormona que varía durante el ciclo menstrual por lo que es normal que exista mucha varianza en los datos. En tercer lugar, el tamaño de los folículos también es normal que varíe, en este caso va de 0 a 30 aproximadamente, por lo que se puede dar el caso de que no existan folículos y que por lo tanto su tamaño sea 0. Lo mismo pasa con el tamaño de los folículos en el ovario derecho. Por último, el endometrio es un tejido que recubre la pared del útero. Pero el tamaño de este tejido varía a lo largo del ciclo; por lo que es normal que hayan valores en los que tengamos 0mm de endometrio o bien 18mm.
Siguiendo este planteamiento, vemos que los valores extremos encontrados no corresponden realmente a valores que haya que eliminar porque tienen congruencia con los datos.
2.3.2 Tablas de frecuencia para las variables cualitativas
Una vez ejecutados los histogramas, veamos por parte de las variables cualitativas (categóricas) si hay algún valor que no esté dentro del rango de los posibles valores de cada variable.
table(df$PCOS..Y.N.)##
## 0 1
## 364 177table(df$Pregnant.Y.N.)##
## 0 1
## 335 206table(df$Blood.Group)##
## 11 12 13 14 15 16 17 18
## 108 13 135 16 206 19 42 2table(df$Weight.gain.Y.N.)##
## 0 1
## 337 204table(df$hair.growth.Y.N.)##
## 0 1
## 393 148table(df$Skin.darkening..Y.N.)##
## 0 1
## 375 166table(df$Hair.loss.Y.N.)##
## 0 1
## 296 245table(df$Pimples.Y.N.)##
## 0 1
## 276 265table(df$Fast.food..Y.N.)##
## 0 1
## 262 279table(df$Reg.Exercise.Y.N.)##
## 0 1
## 407 134Vemos que todos los booleanos contienen dos valores y que con respecto al tipo de sangre, existen 8 valores, los cuales corresponderían a los 8 grupos sanguíneos existentes.
3 Análisis de datos
3.1 Normalidad
Veamos primero los gráficos Q-Q para ver si las variables siguen o no una disfribución normal.
df_numeric_cols <- df[,c(4:7, 9:14, 16:28, 36:42)]
for (i in 1:ncol(df_numeric_cols)) {
qqnorm(df_numeric_cols[,i], main = paste("Normal Q-Q Plot for ", colnames(df_numeric_cols)[i]))
qqline(df_numeric_cols[,i], col= 'green')
}
Comprobemos la normalidad con la prueba de Shapiro-Wilk.
for (i in 1:ncol(df_numeric_cols)){
print(shapiro.test(df[,i]))
}##
## Shapiro-Wilk normality test
##
## data: df[, i]
## W = 0.95473, p-value = 7.895e-12
##
##
## Shapiro-Wilk normality test
##
## data: df[, i]
## W = 0.95473, p-value = 7.895e-12
##
##
## Shapiro-Wilk normality test
##
## data: df[, i]
## W = 0.59157, p-value < 2.2e-16
##
##
## Shapiro-Wilk normality test
##
## data: df[, i]
## W = 0.98573, p-value = 3.826e-05
##
##
## Shapiro-Wilk normality test
##
## data: df[, i]
## W = 0.98016, p-value = 1.015e-06
##
##
## Shapiro-Wilk normality test
##
## data: df[, i]
## W = 0.98543, p-value = 3.095e-05
##
##
## Shapiro-Wilk normality test
##
## data: df[, i]
## W = 0.9894, p-value = 0.0006019
##
##
## Shapiro-Wilk normality test
##
## data: df[, i]
## W = 0.8878, p-value < 2.2e-16
##
##
## Shapiro-Wilk normality test
##
## data: df[, i]
## W = 0.45999, p-value < 2.2e-16
##
##
## Shapiro-Wilk normality test
##
## data: df[, i]
## W = 0.79763, p-value < 2.2e-16
##
##
## Shapiro-Wilk normality test
##
## data: df[, i]
## W = 0.95695, p-value = 1.804e-11
##
##
## Shapiro-Wilk normality test
##
## data: df[, i]
## W = 0.56641, p-value < 2.2e-16
##
##
## Shapiro-Wilk normality test
##
## data: df[, i]
## W = 0.83689, p-value < 2.2e-16
##
##
## Shapiro-Wilk normality test
##
## data: df[, i]
## W = 0.92079, p-value = 2.974e-16
##
##
## Shapiro-Wilk normality test
##
## data: df[, i]
## W = 0.61554, p-value < 2.2e-16
##
##
## Shapiro-Wilk normality test
##
## data: df[, i]
## W = 0.47752, p-value < 2.2e-16
##
##
## Shapiro-Wilk normality test
##
## data: df[, i]
## W = 0.023729, p-value < 2.2e-16
##
##
## Shapiro-Wilk normality test
##
## data: df[, i]
## W = 0.02723, p-value < 2.2e-16
##
##
## Shapiro-Wilk normality test
##
## data: df[, i]
## W = 0.049954, p-value < 2.2e-16
##
##
## Shapiro-Wilk normality test
##
## data: df[, i]
## W = 0.9757, p-value = 8.042e-08
##
##
## Shapiro-Wilk normality test
##
## data: df[, i]
## W = 0.97797, p-value = 2.82e-07
##
##
## Shapiro-Wilk normality test
##
## data: df[, i]
## W = 0.97319, p-value = 2.165e-08
##
##
## Shapiro-Wilk normality test
##
## data: df[, i]
## W = 0.41935, p-value < 2.2e-16
##
##
## Shapiro-Wilk normality test
##
## data: df[, i]
## W = 0.72435, p-value < 2.2e-16
##
##
## Shapiro-Wilk normality test
##
## data: df[, i]
## W = 0.8214, p-value < 2.2e-16
##
##
## Shapiro-Wilk normality test
##
## data: df[, i]
## W = 0.047852, p-value < 2.2e-16
##
##
## Shapiro-Wilk normality test
##
## data: df[, i]
## W = 0.050935, p-value < 2.2e-16
##
##
## Shapiro-Wilk normality test
##
## data: df[, i]
## W = 0.6961, p-value < 2.2e-16
##
##
## Shapiro-Wilk normality test
##
## data: df[, i]
## W = 0.61419, p-value < 2.2e-16
##
##
## Shapiro-Wilk normality test
##
## data: df[, i]
## W = 0.55725, p-value < 2.2e-16Vemos gracias a estas dos pruebas estadísticas que ninguna de las variables numéricas está normalizada. Sin embargo, realizaremos la normalización debido a que por el teorema del límite central, se asume que se se pueden normalizar los datos de una muestra superior a 30 registros con valores de media 0 y de desviación estándar 1.
Deberemos refactorizar las variables que no queremos que sean normalizadas (en este caso, las categóricas y los índices de los pacientes y sus informes).
df_norm <- df%>%
mutate(PCOS..Y.N. = as.factor(PCOS..Y.N.),
Pregnant.Y.N. = as.factor(Pregnant.Y.N.),
Weight.gain.Y.N. = as.factor(Weight.gain.Y.N.),
hair.growth.Y.N. = as.factor(hair.growth.Y.N.),
Skin.darkening..Y.N. = as.factor(Skin.darkening..Y.N.),
Hair.loss.Y.N. = as.factor(Hair.loss.Y.N.),
Pimples.Y.N. = as.factor(Pimples.Y.N.),
Fast.food..Y.N. = as.factor(Fast.food..Y.N.),
Reg.Exercise.Y.N. = as.factor(Reg.Exercise.Y.N.),
Blood.Group = as.factor(Blood.Group),
Age..yrs. = as.factor(Age..yrs.),
Patient.File.No. = as.factor(Patient.File.No.),
Sl..No = as.factor(Sl..No)
)Una vez refactorizadas las variables, deberemos normalizar solamente las variables numéricas.
df_norm <- df_norm %>%
mutate_if(is.numeric, scale)Una vez normalizadas las numéricas, volvemos a transformar todas la variables del dataset a numéricas. De esta manera, tenemos dos tablas finales: una tabla con los datos originales del dataset limpiados; y por otro lado, una talba con los valores de las variables numéricas normalizados.
df_norm[] <- lapply(df_norm, function(x) as.numeric(x))summary(df_norm)## Sl..No Patient.File.No. PCOS..Y.N. Age..yrs.
## Min. : 1 Min. : 1 Min. :1.000 Min. : 1.00
## 1st Qu.:136 1st Qu.:136 1st Qu.:1.000 1st Qu.: 9.00
## Median :271 Median :271 Median :1.000 Median :12.00
## Mean :271 Mean :271 Mean :1.327 Mean :12.43
## 3rd Qu.:406 3rd Qu.:406 3rd Qu.:2.000 3rd Qu.:16.00
## Max. :541 Max. :541 Max. :2.000 Max. :29.00
## Weight..Kg. Height.Cm. BMI Blood.Group
## Min. :-2.59670 Min. :-3.22942 Min. :-2.93201 Min. :1.000
## 1st Qu.:-0.69251 1st Qu.:-0.74332 1st Qu.:-0.65822 1st Qu.:3.000
## Median :-0.05777 Median :-0.08036 Median :-0.01801 Median :4.000
## Mean : 0.00000 Mean : 0.00000 Mean : 0.00000 Mean :3.802
## 3rd Qu.: 0.48628 3rd Qu.: 0.58260 3rd Qu.: 0.57284 3rd Qu.:5.000
## Max. : 4.38535 Max. : 3.89741 Max. : 3.59647 Max. :8.000
## Pulse.rate.bpm. RR..breaths.min. Hb.g.dl. Cycle.R.I.
## Min. :-13.5991 Min. :-1.9211 Min. :-3.0684 Min. :-0.621
## 1st Qu.: -0.2816 1st Qu.:-0.7367 1st Qu.:-0.7614 1st Qu.:-0.621
## Median : -0.2816 Median :-0.7367 Median :-0.1846 Median :-0.621
## Mean : 0.0000 Mean : 0.0000 Mean : 0.0000 Mean : 0.000
## 3rd Qu.: 0.1698 3rd Qu.: 0.4477 3rd Qu.: 0.6229 3rd Qu.: 1.596
## Max. : 1.9756 Max. : 5.1853 Max. : 4.1988 Max. : 2.705
## Cycle.length.days. Marraige.Status..Yrs. Pregnant.Y.N.
## Min. :-3.31152 Min. :-1.6001 Min. :1.000
## 1st Qu.:-0.63059 1st Qu.:-0.7667 1st Qu.:1.000
## Median : 0.03964 Median :-0.1416 Median :1.000
## Mean : 0.00000 Mean : 0.0000 Mean :1.381
## 3rd Qu.: 0.03964 3rd Qu.: 0.4835 3rd Qu.:2.000
## Max. : 4.73127 Max. : 4.6506 Max. :2.000
## No..of.aborptions FSH.mIU.mL. LH.mIU.mL.
## Min. :-0.4164 Min. :-0.06631 Min. :-0.07442
## 1st Qu.:-0.4164 1st Qu.:-0.05208 1st Qu.:-0.06288
## Median :-0.4164 Median :-0.04494 Median :-0.04811
## Mean : 0.0000 Mean : 0.00000 Mean : 0.00000
## 3rd Qu.:-0.4164 3rd Qu.:-0.03775 3rd Qu.:-0.03219
## Max. : 6.8031 Max. :23.21146 Max. :23.20820
## FSH.LH Hip.inch. Waist.inch.
## Min. :-0.11373 Min. :-3.022391 Min. :-2.73598
## 1st Qu.:-0.09043 1st Qu.:-0.502179 1st Qu.:-0.51184
## Median :-0.07803 Median : 0.001863 Median : 0.04419
## Mean : 0.00000 Mean : 0.000000 Mean : 0.00000
## 3rd Qu.:-0.04853 3rd Qu.: 0.505906 3rd Qu.: 0.60023
## Max. :22.50585 Max. : 2.522075 Max. : 3.65842
## Waist.Hip.Ratio TSH..mIU.L. AMH.ng.mL. PRL.ng.mL.
## Min. :-2.94306 Min. :-0.7832 Min. :-0.9394 Min. :-1.5979
## 1st Qu.:-0.75016 1st Qu.:-0.3998 1st Qu.:-0.6144 1st Qu.:-0.6547
## Median : 0.06135 Median :-0.1921 Median :-0.3268 Median :-0.1604
## Mean : 0.00000 Mean : 0.0000 Mean : 0.0000 Mean : 0.0000
## 3rd Qu.: 0.79172 3rd Qu.: 0.1568 3rd Qu.: 0.2177 3rd Qu.: 0.3720
## Max. : 1.88388 Max. :16.5140 Max. :10.2743 Max. : 6.9416
## Vit.D3..ng.mL. PRG.ng.mL. RBS.mg.dl.
## Min. :-0.14418 Min. :-0.14806 Min. :-2.146410
## 1st Qu.:-0.08410 1st Qu.:-0.09477 1st Qu.:-0.422207
## Median :-0.06937 Median :-0.07639 Median : 0.008844
## Mean : 0.00000 Mean : 0.00000 Mean : 0.000000
## 3rd Qu.:-0.04453 3rd Qu.:-0.04226 3rd Qu.: 0.386014
## Max. :17.22886 Max. :22.15603 Max. :13.479181
## Weight.gain.Y.N. hair.growth.Y.N. Skin.darkening..Y.N. Hair.loss.Y.N.
## Min. :1.000 Min. :1.000 Min. :1.000 Min. :1.000
## 1st Qu.:1.000 1st Qu.:1.000 1st Qu.:1.000 1st Qu.:1.000
## Median :1.000 Median :1.000 Median :1.000 Median :1.000
## Mean :1.377 Mean :1.274 Mean :1.307 Mean :1.453
## 3rd Qu.:2.000 3rd Qu.:2.000 3rd Qu.:2.000 3rd Qu.:2.000
## Max. :2.000 Max. :2.000 Max. :2.000 Max. :2.000
## Pimples.Y.N. Fast.food..Y.N. Reg.Exercise.Y.N. BP._Systolic..mmHg.
## Min. :1.00 Min. :1.000 Min. :1.000 Min. :-13.9022
## 1st Qu.:1.00 1st Qu.:1.000 1st Qu.:1.000 1st Qu.: -0.6313
## Median :1.00 Median :2.000 Median :1.000 Median : -0.6313
## Mean :1.49 Mean :1.516 Mean :1.248 Mean : 0.0000
## 3rd Qu.:2.00 3rd Qu.:2.000 3rd Qu.:1.000 3rd Qu.: 0.7229
## Max. :2.00 Max. :2.000 Max. :2.000 Max. : 3.4313
## BP._Diastolic..mmHg. Follicle.No...L. Follicle.No...R.
## Min. :-12.3657 Min. :-1.4493 Min. :-1.4969
## 1st Qu.: -1.2429 1st Qu.:-0.7399 1st Qu.:-0.8207
## Median : 0.5511 Median :-0.2670 Median :-0.1446
## Mean : 0.0000 Mean : 0.0000 Mean : 0.0000
## 3rd Qu.: 0.5511 3rd Qu.: 0.6787 3rd Qu.: 0.7570
## Max. : 4.1392 Max. : 3.7525 Max. : 3.0108
## Avg..F.size..L...mm. Avg..F.size..R...mm. Endometrium..mm.
## Min. :-4.210483 Min. :-4.6557 Min. :-3.91428
## 1st Qu.:-0.565799 1st Qu.:-0.7387 1st Qu.:-0.68160
## Median :-0.005079 Median : 0.1652 Median : 0.01112
## Mean : 0.000000 Mean : 0.0000 Mean : 0.00000
## 3rd Qu.: 0.836002 3rd Qu.: 0.7678 3rd Qu.: 0.61148
## Max. : 2.518164 Max. : 2.5757 Max. : 4.398343.2 PCA: reducción de dimensionalidad
Una vez normalizadas las variables, podemos ejecutar un PCA. Esta prueba es muy útil cuando tratamos con un dataset con muchas variables y queremos realizar una reducción de dimensionalidad. Esta prueba comprueba que haya algún tipo de relación entre las variables que contiene el dataset y elabora una serie de componentes principales que tratan de explicar un tanto por ciento del comportamiento de las variables originales.
# Utilizamos la función prcomp para realizar el PCA.
df_norm.pca <- prcomp(df_norm[,4:42], center = TRUE,scale. = TRUE)
# Utilizamos la función summary() para explorar las proporciones de variancia de cada componente principal.
summary(df_norm.pca)## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6
## Standard deviation 2.0734 1.68005 1.42513 1.38115 1.33461 1.21564
## Proportion of Variance 0.1102 0.07237 0.05208 0.04891 0.04567 0.03789
## Cumulative Proportion 0.1102 0.18260 0.23468 0.28359 0.32926 0.36715
## PC7 PC8 PC9 PC10 PC11 PC12
## Standard deviation 1.15711 1.14068 1.13581 1.0889 1.0780 1.0525
## Proportion of Variance 0.03433 0.03336 0.03308 0.0304 0.0298 0.0284
## Cumulative Proportion 0.40148 0.43485 0.46793 0.4983 0.5281 0.5565
## PC13 PC14 PC15 PC16 PC17 PC18
## Standard deviation 1.03311 1.01675 1.00257 0.99657 0.98955 0.96571
## Proportion of Variance 0.02737 0.02651 0.02577 0.02547 0.02511 0.02391
## Cumulative Proportion 0.58390 0.61040 0.63618 0.66164 0.68675 0.71066
## PC19 PC20 PC21 PC22 PC23 PC24
## Standard deviation 0.95054 0.92889 0.9242 0.90843 0.88120 0.87126
## Proportion of Variance 0.02317 0.02212 0.0219 0.02116 0.01991 0.01946
## Cumulative Proportion 0.73383 0.75595 0.7779 0.79902 0.81893 0.83839
## PC25 PC26 PC27 PC28 PC29 PC30
## Standard deviation 0.86439 0.83296 0.81974 0.78302 0.76797 0.75610
## Proportion of Variance 0.01916 0.01779 0.01723 0.01572 0.01512 0.01466
## Cumulative Proportion 0.85755 0.87534 0.89257 0.90829 0.92341 0.93807
## PC31 PC32 PC33 PC34 PC35 PC36
## Standard deviation 0.73732 0.70191 0.67615 0.6639 0.5373 0.40362
## Proportion of Variance 0.01394 0.01263 0.01172 0.0113 0.0074 0.00418
## Cumulative Proportion 0.95201 0.96464 0.97637 0.9877 0.9951 0.99925
## PC37 PC38 PC39
## Standard deviation 0.16105 0.04887 0.03155
## Proportion of Variance 0.00067 0.00006 0.00003
## Cumulative Proportion 0.99991 0.99997 1.00000Vemos que, el PCA no ayuda a reducir la dimensionalidad del dataset puesto que el componente principal que explica la mayor proporción de variancia solamente describe un 11%, por lo que no es suficiente para determinar el comportamiento de los datos. De ma misma manera ocurre con los otros componentes ya que el modelo ha obtenido 39 componentes de 39 variables observadas, por lo que no hay ninguna agrupacion posible de componentes que expliquen la variación dentro de los datos.
Por lo tanto, seguiremos utilizando todas las variables iniciales. Veamos a continuación un ejemplo de visualización del análisis de componentes principales.
# remotes::install_github('vqv/ggbiplot')
# https://www.rdocumentation.org/packages/ggbiplot/versions/0.55/topics/ggbiplot
# Para el plot haremos que los puntos sean transparentes, mostraremos las elipses en función de los grupos.
ggbiplot(df_norm.pca, alpha = 0.1, ellipse=TRUE, groups=df_norm$PCOS..Y.N., obs.scale = 2, var.scale = 2)
Guardemos pues los dos datasets que hemos recogido. Uno normalizado y el otro con los datos originales tratando los valores perdidos.
write.csv(df, file = 'csv/cleaned_data.csv', row.names = FALSE)
write.csv(df_norm, file = 'csv/cleaned_data_norm.csv', row.names = FALSE)3.3 ¿Qué variables se correlacionan más con la presencia de PCOS?
Para esta primera prueba estadística, deberemos seleccionar las variables que nos interesa relacionar. En este caso todas las variables menos las que determinan los índices (fila y número del informe del paciente). Crearemos la matrix de correlación a partir del dataset y se hará una correlación de Pearson. Se presentará el resultado en un gráfico donde solamente aparecerán las correlaciones significativas que se presentarán en color en función del grado de correlación y su positividad o negatividad.Para esta prueba cogeremos alpha = 0.05.
cor_matrix <- rcorr(as.matrix(df_norm[,c(3:42)]), type = c("pearson"))
corrplot(cor_matrix$r, method = "number", type="upper", order="original",
p.mat = cor_matrix$P, sig.level = 0.05, insig = "blank")
Vemos que las variables que más correlacionan significativamente con la presencia de PCOS son: - número de folículo en el ovario derecho: 0.65 - número de folículos en el ovario izquierdo: 0.6 - oscurecimiento de la piel: 0.48 - crecimiento de pelo: 0.46 - aumento de peso: 0.44
3.4 Modelo de regresión lineal
Realizaremos un modelo de regresión lineal para determinar qué variables influyen más a la hora de tener o no PCOS. Primero, transformaremos la variable que informa de la presencia o la ausencia de PCOS a lógica.
df_norm$PCOS..Y.N.cat <- as.logical(df_norm$PCOS..Y.N.) A continuación, definiremos distintos modelos con las variables que hemos visto en el apartado anterior que correlacionaban más con la presencia de PCOS.
# Regresores cuantitativos
num_follicle_r = df_norm$Follicle.No...R.
num_follicle_l = df_norm$Follicle.No...L.
skin_dark = df_norm$Skin.darkening..Y.N.
hair_growth = df_norm$hair.growth.Y.N.
weight_gain = df_norm$Weight.gain.Y.N.
# Variable a predecir
pcos = df_norm$PCOS..Y.N.cat
# Definición de los modelos
model1 <- lm(pcos ~ num_follicle_r + num_follicle_l + skin_dark, data = df_norm)
model2 <- lm(pcos ~ num_follicle_r + num_follicle_l + hair_growth, data = df_norm)
model3 <- lm(pcos ~ skin_dark + hair_growth + weight_gain, data = df_norm)
model4 <- lm(pcos ~ num_follicle_r + num_follicle_l + weight_gain, data = df_norm)
model5 <- lm(pcos ~ num_follicle_r + weight_gain + hair_growth + skin_dark, data = df_norm)Ahora representaremos los diferentes modelos con una tabla que nos indique el coeficiente de determinación de cada uno. Escogeremos el que mayor coeficiente de determinación obtenga.
# Tabla con los coeficientes de determinación de cada modelo
tabla.coeficientes <- matrix(c(1, summary(model1)$r.squared,
2, summary(model2)$r.squared,
3, summary(model3)$r.squared,
4, summary(model4)$r.squared,
5, summary(model5)$r.squared),
ncol = 2, byrow = TRUE)
colnames(tabla.coeficientes) <- c("Modelo", "R^2")
tabla.coeficientes## Modelo R^2
## [1,] 1 0.4999570
## [2,] 2 0.4999370
## [3,] 3 0.4999715
## [4,] 4 0.4999495
## [5,] 5 0.5000250Vemos que el modelo con mayor coeficiente de determinación es el modelo 5, con un 0.57, lo cual no es un coeficiente muy alto, pero lo probaremos a continuación.
Determinamos los valores de las variables presentes en el modelo y probaremos el modelo para saber si una persona con estas características tiene alta probabilidad de obtener o no PCOS.
prediction <- data.frame(num_follicle_r = 12,
weight_gain = 0,
hair_growth = 1,
skin_dark = 0)
# Predecir el precio
predict(model5, prediction)## 1
## 13.5 Modelo de árbol de clasficación: C50
En este apartado ejecutaremos un modelo de árboles de clasificación (C50) el cual nos ayudará a obtener una serie de reglas que determinarán con qué valores de qué variables existe una alta propabilidad de tener o no PCOS. En primer lugar, debemos factorizar la variable de PCOS ya que esa es la que querremos predecir.
df$PCOS..Y.N. <- factor(df$PCOS..Y.N.,
levels = c(1,0),
labels = c("Yes", "No")) Seleccionamos las variables que nos interesan para el modelo supervisado. Eliminaremos la variable de grupo sanguíneo, puesto que desconocemos la asociación de los número con los grupos sanguíneos
df_supervised <- df[,c(3:7,9:42)]A continuación, tenemos que determinar cuál será nuestra variable principal (y) según la cual se hará el modelo. Por otro lado, se tendrán que seleccionar las variables X con las que trataremos de determinar el valor de y.
set.seed(666)
y <- df_supervised[,1] # Nuestra categoría según la cual se hace el modelo es la variable PCOS..Y.N., la primera del dataset.
X <- df_supervised[,2:39] Para realizar un modelo supervisado, debemos separar la muestra y obtener un dataset para el entrenamiento (con el que haremos el modelo) y otro de test (con el que testearemos la eficacia del modelo). Para ello debemos mezclar las filas, por si existe algún tipo de orden en el dataset del que disponemos. Normalmente se utilizan dos tercios del dataset original para el entrenamiento y un tercio para la prueba.
indexes = sample(1:nrow(df_supervised), size=floor((2/3)*nrow(df_supervised)))
trainX<-X[indexes,]
trainy<-y[indexes]
testX<-X[-indexes,]
testy<-y[-indexes]A continuación veremos qué contiene cada dataset y qué proporción de Sí y No tienen tanto el test como el train.
summary(trainX)## Age..yrs. Weight..Kg. Height.Cm. BMI
## Min. :20.00 Min. :31.00 Min. :137.0 Min. :12.42
## 1st Qu.:27.75 1st Qu.:52.00 1st Qu.:152.0 1st Qu.:21.64
## Median :31.00 Median :60.00 Median :157.0 Median :24.23
## Mean :31.26 Mean :59.48 Mean :156.8 Mean :24.15
## 3rd Qu.:35.00 3rd Qu.:65.00 3rd Qu.:161.0 3rd Qu.:26.40
## Max. :48.00 Max. :91.40 Max. :180.0 Max. :38.54
## Pulse.rate.bpm. RR..breaths.min. Hb.g.dl. Cycle.R.I.
## Min. :13.00 Min. :16.00 Min. : 8.50 Min. :2.000
## 1st Qu.:72.00 1st Qu.:18.00 1st Qu.:10.50 1st Qu.:2.000
## Median :72.00 Median :18.00 Median :11.00 Median :2.000
## Mean :73.17 Mean :19.26 Mean :11.16 Mean :2.564
## 3rd Qu.:74.00 3rd Qu.:20.00 3rd Qu.:11.70 3rd Qu.:4.000
## Max. :82.00 Max. :28.00 Max. :14.80 Max. :5.000
## Cycle.length.days. Marraige.Status..Yrs. Pregnant.Y.N.
## Min. : 0.000 Min. : 0.000 Min. :0.0000
## 1st Qu.: 4.000 1st Qu.: 4.000 1st Qu.:0.0000
## Median : 5.000 Median : 7.000 Median :0.0000
## Mean : 4.964 Mean : 7.378 Mean :0.3972
## 3rd Qu.: 5.250 3rd Qu.:10.000 3rd Qu.:1.0000
## Max. :12.000 Max. :30.000 Max. :1.0000
## No..of.aborptions FSH.mIU.mL. LH.mIU.mL.
## Min. :0.0000 Min. : 0.210 Min. : 0.032
## 1st Qu.:0.0000 1st Qu.: 3.292 1st Qu.: 1.020
## Median :0.0000 Median : 4.860 Median : 2.340
## Mean :0.2722 Mean : 19.281 Mean : 8.366
## 3rd Qu.:0.0000 3rd Qu.: 6.492 3rd Qu.: 3.712
## Max. :5.0000 Max. :5052.000 Max. :2018.000
## FSH.LH Hip.inch. Waist.inch. Waist.Hip.Ratio
## Min. : 0.0021 Min. :26.00 Min. :24.00 Min. :0.7556
## 1st Qu.: 1.3981 1st Qu.:36.00 1st Qu.:32.00 1st Qu.:0.8571
## Median : 2.2071 Median :38.00 Median :34.00 Median :0.8938
## Mean : 8.4845 Mean :37.88 Mean :33.74 Mean :0.8917
## 3rd Qu.: 4.0016 3rd Qu.:40.00 3rd Qu.:36.00 3rd Qu.:0.9286
## Max. :1372.8261 Max. :48.00 Max. :46.00 Max. :0.9773
## TSH..mIU.L. AMH.ng.mL. PRL.ng.mL. Vit.D3..ng.mL.
## Min. : 0.040 Min. : 0.100 Min. : 0.40 Min. : 0.00
## 1st Qu.: 1.460 1st Qu.: 2.007 1st Qu.: 14.78 1st Qu.: 20.98
## Median : 2.180 Median : 3.805 Median : 22.40 Median : 25.85
## Mean : 2.920 Mean : 5.516 Mean : 25.11 Mean : 45.15
## 3rd Qu.: 3.445 3rd Qu.: 6.755 3rd Qu.: 30.77 3rd Qu.: 33.40
## Max. :65.000 Max. :32.000 Max. :128.24 Max. :6014.66
## PRG.ng.mL. RBS.mg.dl. Weight.gain.Y.N. hair.growth.Y.N.
## Min. : 0.0470 Min. : 60.0 Min. :0.0000 Min. :0.0000
## 1st Qu.: 0.2500 1st Qu.: 92.0 1st Qu.:0.0000 1st Qu.:0.0000
## Median : 0.3100 Median :100.0 Median :0.0000 Median :0.0000
## Mean : 0.6325 Mean : 99.9 Mean :0.3556 Mean :0.2639
## 3rd Qu.: 0.4400 3rd Qu.:107.0 3rd Qu.:1.0000 3rd Qu.:1.0000
## Max. :85.0000 Max. :350.0 Max. :1.0000 Max. :1.0000
## Skin.darkening..Y.N. Hair.loss.Y.N. Pimples.Y.N. Fast.food..Y.N.
## Min. :0.0000 Min. :0.0000 Min. :0.0000 Min. :0.0000
## 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.0000
## Median :0.0000 Median :0.0000 Median :0.0000 Median :1.0000
## Mean :0.2972 Mean :0.4194 Mean :0.4444 Mean :0.5222
## 3rd Qu.:1.0000 3rd Qu.:1.0000 3rd Qu.:1.0000 3rd Qu.:1.0000
## Max. :1.0000 Max. :1.0000 Max. :1.0000 Max. :1.0000
## Reg.Exercise.Y.N. BP._Systolic..mmHg. BP._Diastolic..mmHg.
## Min. :0.0000 Min. : 12.0 Min. : 8.00
## 1st Qu.:0.0000 1st Qu.:110.0 1st Qu.: 70.00
## Median :0.0000 Median :110.0 Median : 80.00
## Mean :0.2556 Mean :114.6 Mean : 76.94
## 3rd Qu.:1.0000 3rd Qu.:120.0 3rd Qu.: 80.00
## Max. :1.0000 Max. :140.0 Max. :100.00
## Follicle.No...L. Follicle.No...R. Avg..F.size..L...mm.
## Min. : 0.000 Min. : 0.000 Min. : 0.00
## 1st Qu.: 3.000 1st Qu.: 3.000 1st Qu.:13.00
## Median : 5.000 Median : 6.000 Median :15.00
## Mean : 6.058 Mean : 6.381 Mean :15.09
## 3rd Qu.: 8.000 3rd Qu.:10.000 3rd Qu.:18.00
## Max. :22.000 Max. :20.000 Max. :24.00
## Avg..F.size..R...mm. Endometrium..mm.
## Min. : 0.00 Min. : 0.00
## 1st Qu.:13.00 1st Qu.: 7.00
## Median :16.00 Median : 8.50
## Mean :15.49 Mean : 8.56
## 3rd Qu.:18.00 3rd Qu.:10.00
## Max. :24.00 Max. :18.00summary(trainy)## Yes No
## 115 245summary(testX)## Age..yrs. Weight..Kg. Height.Cm. BMI
## Min. :21.00 Min. : 35.00 Min. :140.0 Min. :14.57
## 1st Qu.:28.00 1st Qu.: 53.00 1st Qu.:152.0 1st Qu.:21.90
## Median :32.00 Median : 58.90 Median :155.4 Median :24.24
## Mean :31.78 Mean : 59.95 Mean :155.9 Mean :24.63
## 3rd Qu.:35.00 3rd Qu.: 65.00 3rd Qu.:160.0 3rd Qu.:27.10
## Max. :47.00 Max. :108.00 Max. :173.0 Max. :38.90
## Pulse.rate.bpm. RR..breaths.min. Hb.g.dl. Cycle.R.I.
## Min. :70.0 Min. :16.00 Min. : 9.40 Min. :2.000
## 1st Qu.:72.0 1st Qu.:18.00 1st Qu.:10.50 1st Qu.:2.000
## Median :72.0 Median :18.00 Median :11.00 Median :2.000
## Mean :73.4 Mean :19.21 Mean :11.17 Mean :2.552
## 3rd Qu.:74.0 3rd Qu.:20.00 3rd Qu.:11.80 3rd Qu.:4.000
## Max. :82.0 Max. :26.00 Max. :14.20 Max. :4.000
## Cycle.length.days. Marraige.Status..Yrs. Pregnant.Y.N.
## Min. : 2.000 Min. : 1.000 Min. :0.0000
## 1st Qu.: 5.000 1st Qu.: 4.000 1st Qu.:0.0000
## Median : 5.000 Median : 7.000 Median :0.0000
## Mean : 4.895 Mean : 8.279 Mean :0.3481
## 3rd Qu.: 5.000 3rd Qu.:11.000 3rd Qu.:1.0000
## Max. :11.000 Max. :25.000 Max. :1.0000
## No..of.aborptions FSH.mIU.mL. LH.mIU.mL. FSH.LH
## Min. :0.0000 Min. : 1.000 Min. : 0.020 Min. : 0.4353
## 1st Qu.:0.0000 1st Qu.: 3.400 1st Qu.: 1.020 1st Qu.: 1.4644
## Median :0.0000 Median : 4.830 Median : 2.110 Median : 2.1368
## Mean :0.3204 Mean : 5.295 Mean : 2.698 Mean : 3.7629
## 3rd Qu.:0.0000 3rd Qu.: 6.270 3rd Qu.: 3.570 3rd Qu.: 3.8663
## Max. :4.0000 Max. :60.370 Max. :14.240 Max. :50.0000
## Hip.inch. Waist.inch. Waist.Hip.Ratio TSH..mIU.L.
## Min. :26.00 Min. :24.00 Min. :0.7619 Min. : 0.050
## 1st Qu.:36.00 1st Qu.:32.00 1st Qu.:0.8500 1st Qu.: 1.560
## Median :38.00 Median :34.00 Median :0.8974 Median : 2.376
## Mean :38.22 Mean :34.04 Mean :0.8923 Mean : 3.102
## 3rd Qu.:40.00 3rd Qu.:36.00 3rd Qu.:0.9333 3rd Qu.: 3.720
## Max. :48.00 Max. :47.00 Max. :0.9792 Max. :22.590
## AMH.ng.mL. PRL.ng.mL. Vit.D3..ng.mL. PRG.ng.mL.
## Min. : 0.160 Min. : 1.36 Min. : 6.5 Min. : 0.1100
## 1st Qu.: 2.100 1st Qu.:13.79 1st Qu.: 20.3 1st Qu.: 0.2500
## Median : 3.700 Median :20.32 Median : 26.4 Median : 0.3200
## Mean : 5.829 Mean :22.76 Mean : 59.4 Mean : 0.5681
## 3rd Qu.: 7.250 3rd Qu.:28.08 3rd Qu.: 36.2 3rd Qu.: 0.4800
## Max. :66.000 Max. :99.93 Max. :5418.6 Max. :25.3000
## RBS.mg.dl. Weight.gain.Y.N. hair.growth.Y.N. Skin.darkening..Y.N.
## Min. : 70.00 Min. :0.0000 Min. :0.0000 Min. :0.000
## 1st Qu.: 92.00 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.000
## Median : 98.00 Median :0.0000 Median :0.0000 Median :0.000
## Mean : 99.71 Mean :0.4199 Mean :0.2928 Mean :0.326
## 3rd Qu.:107.00 3rd Qu.:1.0000 3rd Qu.:1.0000 3rd Qu.:1.000
## Max. :160.00 Max. :1.0000 Max. :1.0000 Max. :1.000
## Hair.loss.Y.N. Pimples.Y.N. Fast.food..Y.N. Reg.Exercise.Y.N.
## Min. :0.0000 Min. :0.0000 Min. :0.0000 Min. :0.000
## 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.000
## Median :1.0000 Median :1.0000 Median :1.0000 Median :0.000
## Mean :0.5193 Mean :0.5801 Mean :0.5028 Mean :0.232
## 3rd Qu.:1.0000 3rd Qu.:1.0000 3rd Qu.:1.0000 3rd Qu.:0.000
## Max. :1.0000 Max. :1.0000 Max. :1.0000 Max. :1.000
## BP._Systolic..mmHg. BP._Diastolic..mmHg. Follicle.No...L.
## Min. :100.0 Min. :60.00 Min. : 0.000
## 1st Qu.:110.0 1st Qu.:70.00 1st Qu.: 3.000
## Median :110.0 Median :80.00 Median : 5.000
## Mean :114.8 Mean :76.91 Mean : 6.271
## 3rd Qu.:120.0 3rd Qu.:80.00 3rd Qu.: 9.000
## Max. :140.0 Max. :80.00 Max. :21.000
## Follicle.No...R. Avg..F.size..L...mm. Avg..F.size..R...mm.
## Min. : 1.00 Min. : 0.00 Min. : 0.17
## 1st Qu.: 4.00 1st Qu.:13.00 1st Qu.:13.00
## Median : 6.00 Median :15.00 Median :16.00
## Mean : 7.16 Mean :14.87 Mean :15.37
## 3rd Qu.:10.00 3rd Qu.:18.00 3rd Qu.:18.00
## Max. :20.00 Max. :21.00 Max. :22.00
## Endometrium..mm.
## Min. : 0.000
## 1st Qu.: 7.000
## Median : 8.400
## Mean : 8.309
## 3rd Qu.: 9.600
## Max. :15.000summary(testy)## Yes No
## 62 119Ejecutamos el modelo en el dataset de entrenamiento y obtenemos las reglas.
modelo <- C50::C5.0(trainX, trainy,rules=TRUE )
summary(modelo)##
## Call:
## C5.0.default(x = trainX, y = trainy, rules = TRUE)
##
##
## C5.0 [Release 2.07 GPL Edition] Thu Jan 2 21:17:35 2020
## -------------------------------
##
## Class specified by attribute `outcome'
##
## Read 360 cases (39 attributes) from undefined.data
##
## Rules:
##
## Rule 1: (58, lift 3.1)
## Weight.gain.Y.N. > 0
## Follicle.No...R. > 8
## -> class Yes [0.983]
##
## Rule 2: (42, lift 3.1)
## Cycle.R.I. > 2
## Marraige.Status..Yrs. <= 13
## Weight.gain.Y.N. > 0
## Follicle.No...R. > 4
## -> class Yes [0.977]
##
## Rule 3: (13, lift 2.9)
## Weight..Kg. > 56
## Reg.Exercise.Y.N. > 0
## Follicle.No...R. > 8
## Follicle.No...R. <= 12
## -> class Yes [0.933]
##
## Rule 4: (29/2, lift 2.8)
## Follicle.No...R. > 12
## -> class Yes [0.903]
##
## Rule 5: (15/1, lift 2.8)
## LH.mIU.mL. > 4.75
## hair.growth.Y.N. > 0
## -> class Yes [0.882]
##
## Rule 6: (73/12, lift 2.6)
## Follicle.No...L. > 9
## -> class Yes [0.827]
##
## Rule 7: (20/3, lift 2.6)
## Marraige.Status..Yrs. <= 3.5
## hair.growth.Y.N. > 0
## -> class Yes [0.818]
##
## Rule 8: (75/15, lift 2.5)
## Cycle.R.I. > 2
## Follicle.No...R. > 4
## -> class Yes [0.792]
##
## Rule 9: (103/1, lift 1.4)
## Weight.gain.Y.N. <= 0
## hair.growth.Y.N. <= 0
## Pimples.Y.N. <= 0
## Reg.Exercise.Y.N. <= 0
## Follicle.No...R. <= 12
## -> class No [0.981]
##
## Rule 10: (117/2, lift 1.4)
## Hip.inch. > 32
## Weight.gain.Y.N. <= 0
## hair.growth.Y.N. <= 0
## Reg.Exercise.Y.N. <= 0
## Follicle.No...R. <= 12
## -> class No [0.975]
##
## Rule 11: (161/3, lift 1.4)
## Cycle.R.I. <= 2
## hair.growth.Y.N. <= 0
## Follicle.No...L. <= 9
## Follicle.No...R. <= 8
## -> class No [0.975]
##
## Rule 12: (146/3, lift 1.4)
## Cycle.R.I. <= 2
## Marraige.Status..Yrs. > 3.5
## LH.mIU.mL. <= 4.75
## Follicle.No...L. <= 9
## Follicle.No...R. <= 8
## -> class No [0.973]
##
## Rule 13: (28, lift 1.4)
## Marraige.Status..Yrs. > 13
## Follicle.No...L. <= 9
## -> class No [0.967]
##
## Rule 14: (153/5, lift 1.4)
## Vit.D3..ng.mL. > 21.4
## hair.growth.Y.N. <= 0
## Follicle.No...R. <= 8
## -> class No [0.961]
##
## Rule 15: (140/7, lift 1.4)
## Follicle.No...R. <= 4
## -> class No [0.944]
##
## Rule 16: (45/4, lift 1.3)
## Marraige.Status..Yrs. > 11
## Weight.gain.Y.N. <= 0
## -> class No [0.894]
##
## Default class: No
##
##
## Evaluation on training data (360 cases):
##
## Rules
## ----------------
## No Errors
##
## 16 13( 3.6%) <<
##
##
## (a) (b) <-classified as
## ---- ----
## 105 10 (a): class Yes
## 3 242 (b): class No
##
##
## Attribute usage:
##
## 95.83% Follicle.No...R.
## 73.06% Follicle.No...L.
## 71.67% Cycle.R.I.
## 67.22% hair.growth.Y.N.
## 62.50% Marraige.Status..Yrs.
## 61.94% Weight.gain.Y.N.
## 44.72% LH.mIU.mL.
## 42.50% Vit.D3..ng.mL.
## 41.39% Reg.Exercise.Y.N.
## 32.50% Hip.inch.
## 28.61% Pimples.Y.N.
## 3.61% Weight..Kg.
##
##
## Time: 0.0 secsFinalmente, obtenemos 16 reglas, y para cada uno obtenemos la validez de la regla así como el procentaje de aportación de las variables más influyentes en el diagnóstico de PCOS. De estas reglas describiremos las que tienen una validez superir al 96%:
Regla 1 => Si la persona ha ganado peso y tiene más de 8 folículos en el ovario derecho, es posible que tenga PCOS (98% de validez).
Regla 2 => si la persona lleva menos de 14 años casada, ha ganado peso, tiene más de 4 folículo en el ovario derecho y su irregularidad en el ciclo es mayor a dos días, entonces es probable que tenga PCOS (validez de 98%).
Regla 3 => Si la persona no ha ganado peso, ni le ha crecido el pelo, ni tiene acné, no hace ejercicio regularmente y tiene menos de 13 folículos en el ovario derecho, tiene baja probabilidad de tener PCOS (validez de 98%).
Regla 4 => Si la cadera de la persona mide más de 32 pulgadas (81 cm), no ha ganado peso, no tiene crecimiento ed pelo, no hace ejercicio regularmente y no tiene más de 12 folículos, tiene baja probabilidad de tener PCOS (validez de 98%).
Regla 5 => Si la persona tiene una desregulación del ciclo menor a dos días, no tiene crecimiento de pelo, tiene menos de 10 folículos en el ovario izquierdo y menos de 9 en el derecho, tiene baja probabilidad de tener PCOS (validez de 98%).
Regla 6 => Si la persona ha estado casada más de 3 años y medio, tiene niveles de LH más bajos que 4.76, y tiene menos de 10 folículos enel ovario izquierdo y menos de 9 en el derecho, tiene baja probabilidad de tener PCOS (validez de 97%).
A continuación se muestra el árbol de clasificación que representa el modelo desarrollado. En él podemos qué valore sde cada variable influyen en la presencia o ausencia de PCOS en cada caso.
modelo <- C50::C5.0(trainX, trainy)
plot(modelo, cex=150)
Ahora verificaremos la precisión del modelo con la muestra de prueba (test)
predicted_model <- predict(modelo, testX, type="class" )
print(sprintf("La precisión del árbol es: %.4f %%",100*sum(predicted_model == testy) / length(predicted_model)))## [1] "La precisión del árbol es: 86.1878 %"4 Conclusiones
Durante esta práctica se han aplicado tres métodos estadísticos. Por una parte, una evaluación de los índices de correlación entre las variables de la muestra. De ellas se han podido extraer qué variables influyen más en la presencia o la ausencia de PCOS. La visualización de esta matriz ha sido mediante un gráfico en el cual veíamos solamente los valores de correlación significativos. Por otra parte, se ha realizado un modelo de regresión lineal en el que hemos podido ver de la misma manera, de entre las variables que más se correlacionan con la presencia de PCOS, qué combinación determina de la mejor manera la presencia o la ausencia de PCOS. La visualización de estos modelos ha sido mediante una tabla en la que podíamos ver el coeficiente de deteminación de cada uno de los modelos con una prueba final del modelo con mejor R^2. Por último, se ha realizado un modelo de árbol de clasificación con el paquete C50. En él hemos podido ver qué valores de qué variables determinaban o no la presencia o la ausencia de PCOS. A partir de este modelo hemos podido sacar una serie de reglas, finalmente representadas mediante un árbol de clasificación.
Es cierto que muchos de los valores finales de los modelos, por ejemplo, el análisis de correlación y el modelo de regresión lineal, no han dado resultados muy prometedores en cuanto a la precisión del diagnóstico de PCOS. Para ello, en futuros trabajos sería necesaria tener una muestra más amplia. Además de tener más claridad en las variables ya que muchas de ellas dependen del momento en el que se ha hecho el análisis puesto que pueden variar mucho en función del tiempo: por ejemplo, los niveles hormonales, sobre todo de FSH y LH varían en función del momento del ciclo en el que se encuentre la paciente. Es por eso que, en futuros trabajos, sería interesante obtener varios registros para cada paciente y saber en qué momento del ciclo han sido extraídos, para que los modelos sean más precisos y ajustados a la realidad y las variables médicas habituales.
Lo que no cabe duda es que, el número de folículos influye en el diagnóstico de este síndrome ya que estas variables han sido significativamente representativas de la presencia de PCOS en caso de tener valores elevados; lo cual cuadra con los procedimientos actuales para el diagnóstico del síndrome hoy en día.